home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1997 / HAM Radio 1997.iso / vcls / moden / examples / tdmain.pas < prev    next >
Pascal/Delphi Source File  |  1996-04-08  |  6KB  |  244 lines

  1. {$G+,X+,F+}
  2.  
  3. {Conditional defines that may affect this unit}
  4. {$I AWDEFINE.INC}
  5.  
  6. {*********************************************************}
  7. {*                    TDMAIN.PAS 1.01                    *}
  8. {*        Copyright (c) TurboPower Software 1995         *}
  9. {*                 All rights reserved.                  *}
  10. {*********************************************************}
  11.  
  12. unit TDMain;
  13.  
  14. interface
  15.  
  16. uses
  17.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  18.   Forms, Dialogs, AdMisc, AdExcept, AdTerm, AdPort, AdXPort,
  19.   Menus, ExtCtrls, StdCtrls;
  20.  
  21. type
  22.   TMainForm = class(TForm)
  23.     Terminal1: TApdTerminal;
  24.     Emulator1: TApdEmulator;
  25.     MainMenu1: TMainMenu;
  26.     F1: TMenuItem;
  27.     E1: TMenuItem;
  28.     C1: TMenuItem;
  29.     F2: TMenuItem;
  30.     P1: TMenuItem;
  31.     C2: TMenuItem;
  32.     N1: TMenuItem;
  33.     E2: TMenuItem;
  34.     C3: TMenuItem;
  35.     S1: TMenuItem;
  36.     StatusLine: THeader;
  37.     OpenDialog1: TOpenDialog;
  38.     FontDialog1: TFontDialog;
  39.     ApdComPort1: TApdComPort;
  40.     procedure Terminal1TerminalStatus(CP: TObject; Row, Col: Byte; BufRow,
  41.       BufCol: Word);
  42.     procedure P1Click(Sender: TObject);
  43.     procedure ApdComPort1PortChange(CP: TObject);
  44.     procedure FormActivate(Sender: TObject);
  45.     procedure FormCreate(Sender: TObject);
  46.     procedure C2Click(Sender: TObject);
  47.     procedure E2Click(Sender: TObject);
  48.     procedure C3Click(Sender: TObject);
  49.     procedure S1Click(Sender: TObject);
  50.     procedure F2Click(Sender: TObject);
  51.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  52.       Shift: TShiftState);
  53.   private
  54.     { Private declarations }
  55.     procedure AppIdle(Sender: TObject; var Done: Boolean);
  56.     procedure UpdateComInfo(Term : TApdTerminal);
  57.   public
  58.     { Public declarations }
  59.   end;
  60.  
  61. var
  62.   MainForm: TMainForm;
  63.  
  64. implementation
  65.  
  66. const
  67.   UseFile : Boolean = False;
  68.  
  69. var
  70.   AnsiFile : String;
  71.   AF       : File;
  72.   AFBuffer : array[1..4096] of Char;
  73.   AFIndex  : Word;
  74.  
  75. {$R *.DFM}
  76.  
  77. function IntToStr(L : Longint) : String;
  78. begin
  79.   Str(L , Result);
  80. end;
  81.  
  82. procedure OpenFile;
  83.   {-Open file and prepare for playback}
  84. begin
  85.   Assign(AF, AnsiFile);
  86.   Reset(AF,1);
  87.   UseFile := True;
  88.   AFIndex := SizeOf(AFBuffer)+1;
  89.   if IoResult <> 0 then
  90.     Halt;
  91. end;
  92.  
  93. function ReadNextChar(var C : Char) : Boolean;
  94.   {-Return next character from AF}
  95. const
  96.   BytesRead : Word = 0;
  97. begin
  98.   ReadNextChar := False;
  99.   if AFIndex > BytesRead then begin
  100.     BlockRead(AF, AFBuffer, SizeOf(AFBuffer), BytesRead);
  101.     if (IoResult <> 0) or (BytesRead = 0) then
  102.       Exit;
  103.     AFIndex := 1;
  104.   end;
  105.   C := AFBuffer[AFIndex];
  106.   Inc(AFIndex);
  107.   ReadNextChar := True;
  108. end;
  109.  
  110. procedure TMainForm.AppIdle(Sender: TObject; var Done: Boolean);
  111. const
  112.   PaintInterval = 200;
  113.   CharCount : Word = 0;
  114. var
  115.   C : Char;
  116. begin
  117.   Done := True;
  118.   if UseFile then
  119.     repeat
  120.       {Get next char from file}
  121.       if ReadNextChar(C) then begin
  122.         Terminal1.StuffChar(C);
  123.         Inc(CharCount);
  124.         if CharCount > PaintInterval then begin
  125.           Terminal1.ForcePaint;
  126.           CharCount := 0;
  127.           Exit;
  128.         end else begin
  129.           Done := False;
  130.           Exit;
  131.         end;
  132.       end else begin
  133.         Terminal1.ForcePaint;
  134.         CloseFile(AF);
  135.         UseFile := False;
  136.         Exit;
  137.       end;
  138.     until False;
  139. end;
  140.  
  141. procedure TMainForm.UpdateComInfo(Term : TApdTerminal);
  142.   {-Update the comport information}
  143. var
  144.   S : String;
  145. begin
  146.   {Name}
  147.   S := ' ' + ComName(Term.ComPort.ComNumber) + ' ';
  148.  
  149.   {Line params}
  150.   S := S + IntToStr(Term.ComPort.Databits);
  151.   S := S + ParityName[Term.ComPort.Parity, 1];
  152.   S := S + IntToStr(Term.ComPort.Stopbits) + ' ';
  153.  
  154.   {Baud}
  155.   S := S + IntToStr(Term.ComPort.Baud);
  156.  
  157.   StatusLine.Sections[0] := S;
  158. end;
  159.  
  160. procedure TMainForm.Terminal1TerminalStatus(CP: TObject; Row, Col: Byte;
  161.                                          BufRow, BufCol: Word);
  162. begin
  163.   {Update rows/columns}
  164.   StatusLine.Sections[1] := Format('%2d %2d', [Row, Col]);
  165.   StatusLine.Sections[2] := Format('%2d %2d', [BufRow, BufCol]);
  166.   StatusLine.Sections[3] := '';
  167.  
  168.   {Set widths}
  169.   StatusLine.SectionWidth[0] := 135;
  170.   StatusLine.SectionWidth[1] := 45;
  171.   StatusLine.SectionWidth[2] := 55;
  172. end;
  173.  
  174. procedure TMainForm.P1Click(Sender: TObject);
  175. begin
  176.   if OpenDialog1.Execute then begin
  177.     {Open file and prepare to read}
  178.     AnsiFile := OpenDialog1.FileName;
  179.     OpenFile;
  180.   end;
  181. end;
  182.  
  183. procedure TMainForm.ApdComPort1PortChange(CP: TObject);
  184. begin
  185.   {Update the cominfo portion of the status line}
  186.   UpdateComInfo(Terminal1);
  187. end;
  188.  
  189. procedure TMainForm.FormActivate(Sender: TObject);
  190. begin
  191.   UpdateComInfo(Terminal1);
  192. end;
  193.  
  194. procedure TMainForm.FormCreate(Sender: TObject);
  195. begin
  196.   Application.OnIdle := AppIdle;
  197. end;
  198.  
  199. procedure TMainForm.C2Click(Sender: TObject);
  200. begin
  201.   Terminal1.ClearBuffer;
  202. end;
  203.  
  204. procedure TMainForm.E2Click(Sender: TObject);
  205. begin
  206.   Close;
  207. end;
  208.  
  209. procedure TMainForm.C3Click(Sender: TObject);
  210. begin
  211.   Terminal1.CopyToClipboard;
  212. end;
  213.  
  214. procedure TMainForm.S1Click(Sender: TObject);
  215. begin
  216.   if Assigned(ApdComPort1) then
  217.     ComPortOptions.ComPort := ApdComPort1;
  218.  
  219.   if ComPortOptions.Execute then begin
  220.     ApdComPort1.Open := False;
  221.     ApdComPort1.Assign(ComPortOptions.ComPort);
  222.     ApdComPort1.Open := True;
  223.   end;
  224.  
  225.   {Give focus back to terminal window}
  226.   Terminal1.SetFocus;
  227. end;
  228.  
  229. procedure TMainForm.F2Click(Sender: TObject);
  230. begin
  231.   FontDialog1.Font := Terminal1.Font;
  232.   if FontDialog1.Execute then
  233.     Terminal1.Font := FontDialog1.Font;
  234. end;
  235.  
  236. procedure TMainForm.FormKeyDown(Sender: TObject; var Key: Word;
  237.                                 Shift: TShiftState);
  238. begin
  239.   if Key = VK_INSERT then
  240.     Terminal1.Scrollback := not Terminal1.Scrollback;
  241. end;
  242.  
  243. end.
  244.